Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue42/diagram/MainForm.pas

Pascal/Delphi Source File | 1999-01-13 | 12.2 KB | 417 lines

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, JimShape, ImgList, ExtCtrls;

type
  TjimNextAction = (jnaNone,jnaAddActor,jnaAddUseCase,
                    jnaStartDouble,jnaEndDouble,
                    jnaStartUsesArrow,jnaEndUsesArrow,
                    jnaStartExtendsArrow,jnaEndExtendsArrow);

  TjimArrowType = (jatDouble,jatUses,jatExtends);


  TMainDlg = class(TForm)
    ToolBar1: TToolBar;
    ScrollBox1: TScrollBox;
    NewBtn: TToolButton;
    OpenBtn: TToolButton;
    SaveBtn: TToolButton;
    ToolButton5: TToolButton;
    SelectBtn: TToolButton;
    ActorBtn: TToolButton;
    UseCaseBtn: TToolButton;
    DoubleArrowBtn: TToolButton;
    UsesArrowBtn: TToolButton;
    BtnImageList: TImageList;
    ExtendsArrowBtn: TToolButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    DiagImageList: TImageList;
    ToolButton1: TToolButton;
    DeleteBtn: TToolButton;
    StatusBar: TStatusBar;
    procedure NewBtnClick(Sender: TObject);
    procedure OpenBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure SelectBtnClick(Sender: TObject);
    procedure ActorBtnClick(Sender: TObject);
    procedure UseCaseBtnClick(Sender: TObject);
    procedure DoubleArrowBtnClick(Sender: TObject);
    procedure UsesArrowBtnClick(Sender: TObject);
    procedure ExtendsArrowBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ScrollBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DeleteBtnClick(Sender: TObject);
  private
    FNextAction : TjimNextAction;
    FStartShape : TjimCustomShape;
    FEndShape   : TjimCustomShape;

    procedure SetNextAction(Value : TjimNextAction);
    procedure ChooseButton(TheButton : TToolButton);
    procedure ConnectShapes(StartShape,EndShape : TjimCustomShape;
                            ArrowType : TjimArrowType);
  public
    property NextAction : TjimNextAction read FNextAction write SetNextAction;
  published
    // The OnClick event handler for all shapes on the diagram
    procedure ShapeClick(Sender : TObject);
    // The OnDblClick event handler for all captions on the diagram
    procedure CaptionDblClick(Sender : TObject);
  end;


  EDiagramError = class(Exception);


var
  MainDlg: TMainDlg;


implementation

{$R *.DFM}

uses
  CaptionEditForm;


procedure TMainDlg.SetNextAction(Value: TjimNextAction);
begin
  FNextAction := Value;

  case FNextAction of
    jnaNone              : StatusBar.Panels[0].Text := 'Waiting';
    jnaAddActor          : StatusBar.Panels[0].Text := 'Place an actor on the diagram';
    jnaAddUseCase        : StatusBar.Panels[0].Text := 'Place a use case on the diagram';
    jnaStartDouble       : StatusBar.Panels[0].Text := 'Choose the actor';
    jnaEndDouble         : StatusBar.Panels[0].Text := 'Choose the use case';
    jnaStartUsesArrow    : StatusBar.Panels[0].Text := 'Choose the first use case';
    jnaEndUsesArrow      : StatusBar.Panels[0].Text := 'Choose the second use case';
    jnaStartExtendsArrow : StatusBar.Panels[0].Text := 'Choose the first use case';
    jnaEndExtendsArrow   : StatusBar.Panels[0].Text := 'Choose the second use case';
  end;
end;


procedure TMainDlg.ChooseButton(TheButton : TToolButton);
  var
    i : Integer;
begin {ChooseButton}
  with ToolBar1 do begin
    for i := 0 to ButtonCount - 1 do begin
      Buttons[i].Down := (Buttons[i] = TheButton);
    end;
  end;

  TheButton.Click;
end;  {ChooseButton}


procedure TMainDlg.ConnectShapes(StartShape,EndShape : TjimCustomShape;
                                 ArrowType : TjimArrowType);
  var
    TempConnector         : TjimConnector;
    StartSide,EndSide     : TjimConnectionSide;
    StartOffset,EndOffset : Integer;
begin {ConnectShapes}
  TempConnector := nil;
  StartSide     := csRight;
  EndSide       := csLeft;
  StartOffset   := FStartShape.Height div 2;
  EndOffset     := FEndShape.Height div 2;

  case ArrowType of
    jatDouble  : begin
      TempConnector := TjimDoubleHeadArrow.Create(Self);
    end;

    jatUses,
    jatExtends : begin
      TempConnector := TjimBluntSingleHeadArrow.Create(Self);
      // Change the connection sides to top and bottom
      StartSide     := csBottom;
      EndSide       := csTop;
      StartOffset   := FStartShape.Width div 2;
      EndOffset     := FEndShape.Width div 2;

      // Create the caption
      TempConnector.Caption := TjimTextShape.Create(Self);
      TempConnector.Caption.OnDblClick := CaptionDblClick;

      if ArrowType = jatUses then begin
        TempConnector.Caption.Text := '<<uses>>';
      end else begin
        TempConnector.Caption.Text := '<<extends>>';
      end;
    end;
  end;

  with TempConnector do begin
    // Set the start connection
    StartConn.Side   := StartSide;
    StartConn.Offset := StartOffset;
    StartConn.Shape  := FStartShape;
    // Set the end connection
    EndConn.Side     := EndSide;
    EndConn.Offset   := EndOffset;
    EndConn.Shape    := FEndShape;
    // Ensure the size is correct
    SetBoundingRect;
    // Ensure the new control is visible
    Parent := ScrollBox1;

    // Align the caption to near the midpoint of the connector, if necessary
    if Assigned(Caption) then begin
      Caption.SetBounds(GetMidPoint.X + 20,GetMidPoint.Y,Caption.Width,Caption.Height);
    end;
  end;
end;  {ConnectShapes}


procedure TMainDlg.ShapeClick(Sender : TObject);
begin {ShapeClick}
  if not (Sender is TjimCustomShape) then begin
    Exit;
  end;

  case FNextAction of
    jnaStartDouble : begin
      // Check that it is an allowed shape
      if not (Sender is TjimBitmapShape) then begin
        raise EDiagramError.Create('You must join an actor to a use case');
      end;

      FStartShape := TjimCustomShape(Sender);
      NextAction  := jnaEndDouble;
    end;

    jnaEndDouble : begin
      // Check that it is an allowed shape
      if Sender = FStartShape then begin
        raise EDiagramError.Create('You cannot join an actor to itself, ' +
                                   'choose a use case instead');
      end else if not (Sender is TjimStandardShape) then begin
        raise EDiagramError.Create('You must join an actor to a use case');
      end;

      FEndShape := TjimCustomShape(Sender);
      ConnectShapes(FStartShape,FEndShape,jatDouble);
      ChooseButton(SelectBtn);
    end;

    jnaStartUsesArrow : begin
      // Check that it is an allowed shape
      if not (Sender is TjimStandardShape) then begin
        raise EDiagramError.Create('You must join a use case to a use case');
      end;

      FStartShape := TjimCustomShape(Sender);
      NextAction  := jnaEndUsesArrow;
    end;

    jnaEndUsesArrow : begin
      // Check that it is an allowed shape
      if Sender = FStartShape then begin
        raise EDiagramError.Create('You cannot join a use case to itself, ' +
                                   'choose another use case instead');
      end else if not (Sender is TjimStandardShape) then begin
        raise EDiagramError.Create('You must join a use case to a use case');
      end;

      FEndShape := TjimCustomShape(Sender);
      ConnectShapes(FStartShape,FEndShape,jatUses);
      ChooseButton(SelectBtn);
    end;

    jnaStartExtendsArrow : begin
      // Check that it is an allowed shape
      if not (Sender is TjimStandardShape) then begin
        raise EDiagramError.Create('You must join a use case to a use case');
      end;

      FStartShape := TjimCustomShape(Sender);
      NextAction  := jnaEndExtendsArrow;
    end;

    jnaEndExtendsArrow : begin
      // Check that it is an allowed shape
      if Sender = FStartShape then begin
        raise EDiagramError.Create('You cannot join a use case to itself, ' +
                                   'choose another use case instead');
      end else if not (Sender is TjimStandardShape) then begin
        raise EDiagramError.Create('You must join a use case to a use case');
      end;

      FEndShape := TjimCustomShape(Sender);
      ConnectShapes(FStartShape,FEndShape,jatExtends);
      ChooseButton(SelectBtn);
    end;
  end;
end;  {ShapeClick}


procedure TMainDlg.CaptionDblClick(Sender : TObject);
  var
    TempText : string;
    TempFont : TFont;
begin {CaptionDblClick}
  if Sender is TjimTextShape then begin
    with TjimTextShape(Sender) do begin
      // Use local variables because cannot pass properties as var parameters
      TempText := Text;
      TempFont := Font;
      TCaptionEditDlg.NewCaption(TempText,TempFont);
      Text := TempText;
      Font := TempFont;
    end;
  end;
end;  {CaptionDblClick}


procedure TMainDlg.FormCreate(Sender: TObject);
begin
  NextAction  := jnaNone;
  FStartShape := nil;
  FEndShape   := nil;
end;


procedure TMainDlg.NewBtnClick(Sender: TObject);
begin
  TjimCustomShape.DeleteAllShapes(ScrollBox1);
end;


procedure TMainDlg.OpenBtnClick(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    TjimCustomShape.LoadFromFile(OpenDialog1.FileName,ScrollBox1);
  end;
end;


procedure TMainDlg.SaveBtnClick(Sender: TObject);
begin
  if SaveDialog1.Execute then begin
    TjimCustomShape.SaveToFile(SaveDialog1.FileName,ScrollBox1);
  end;
end;


procedure TMainDlg.SelectBtnClick(Sender: TObject);
begin
  // Don't add anything to the diagram on the next click on the scrollbox
  NextAction  := jnaNone;
end;


procedure TMainDlg.ActorBtnClick(Sender: TObject);
begin
  // Add an actor to the diagram on the next click on the scrollbox
  NextAction  := jnaAddActor;
end;


procedure TMainDlg.UseCaseBtnClick(Sender: TObject);
begin
  // Add a use case to the diagram on the next click on the scrollbox
  NextAction  := jnaAddUseCase;
end;


procedure TMainDlg.DoubleArrowBtnClick(Sender: TObject);
begin
  // Connect an actor to a use case
  NextAction  := jnaStartDouble;
  FStartShape := nil;
  FEndShape   := nil;
end;


procedure TMainDlg.UsesArrowBtnClick(Sender: TObject);
begin
  // Connect 2 use cases
  NextAction  := jnaStartUsesArrow;
  FStartShape := nil;
  FEndShape   := nil;
end;


procedure TMainDlg.ExtendsArrowBtnClick(Sender: TObject);
begin
  // Connect 2 use cases
  NextAction  := jnaStartExtendsArrow;
  FStartShape := nil;
  FEndShape   := nil;
end;


procedure TMainDlg.DeleteBtnClick(Sender: TObject);
begin
  TjimCustomShape.DeleteSelectedShapes(ScrollBox1);
end;


procedure TMainDlg.ScrollBox1MouseDown(Sender : TObject;Button : TMouseButton;
                                       Shift : TShiftState;X,Y : Integer);
begin
  case FNextAction of
    jnaNone : TjimCustomShape.UnselectAllShapes(ScrollBox1);

    jnaAddActor : begin
      with TjimBitmapShape.Create(Self) do begin
        Caption            := TjimTextShape.Create(Self);
        Caption.Text       := 'New Actor';
        Caption.OnDblClick := CaptionDblClick;
        Images             := DiagImageList;
        ImageIndex         := 0;
        Top                := Y;
        Left               := X;
        OnClick            := ShapeClick;
        Parent             := ScrollBox1;
        AlignCaption(taCenter);
      end;

      ChooseButton(SelectBtn);
    end;

    jnaAddUseCase : begin
      with TjimStandardShape.Create(Self) do begin
        Caption            := TjimTextShape.Create(Self);
        Caption.Text       := 'New Use Case';
        Caption.OnDblClick := CaptionDblClick;
        ShapeType          := stEllipse;
        Top                := Y;
        Left               := X;
        OnClick            := ShapeClick;
        Parent             := ScrollBox1;
        AlignCaption(taCenter);
        Caption.Top := Top + (Height div 2) - (Caption.Height div 2);
      end;

      ChooseButton(SelectBtn);
    end;

    jnaStartDouble,
    jnaEndDouble,
    jnaStartUsesArrow,
    jnaEndUsesArrow,
    jnaStartExtendsArrow,
    jnaEndExtendsArrow : begin
      // Shouldn't really get here when doing anything useful, so treat it as
      // clearing the setting
      ChooseButton(SelectBtn);
    end;
  end;
end;


end.